00100		DIMENSION II(1024),JJ(1024),KK(1024),LL(1024),KP(5),NN(4096)
00200		1,A(384),B(384),IB(512)
00300		COMMON KP,NP,NN,JF
00400		IMP(I)=IABS(NN(I)/100000000)
00500	1	JE=0
00600		MN=0
00700		IP=-1
00800		MO=0
00900		NZ=10
01000		IM=0
01100		JF=0
01200		IS=-1
01300		NF=0
01400		LF=1
01500		CALL DPYCLR
01600		CALL TYPLOC(-350,-511)
01700		DO 407 I=1,4
01800	407	KP(I)='     '
01900		CALL DPYSET(4,LL,1000)
02000		CALL DPYSET(3,KK,1000)
02100		CALL DPYSET(2,JJ,1000)
02200		CALL DPYSET(1,II,1000)
02300		MN=0
02400	2	TYPE 5
02500	5	FORMAT(' TYPE:<CR>;TO DRAW NEW PICTURE.'/
02600		1' OR TYPE IN NAME TO USE OLD PICTURE.'/)
02700		ACCEPT 3,NAM
02800	3	FORMAT(A5)
02900		IF(NAM.EQ.'     ')GO TO 140
03000	   	IF(.NOT.LOOKD(NAM))GO TO 2
03100	515	CALL IFILE(1,NAM)
03200		READ(1)LE,(NN(K),K=MN+1,MN+LE)
03300		MN=MN+LE
03400		IP=-1
03500		IF(MO.NE.'P')GO TO 517
03600		MO=100000000
03700		DO 518 K=MN-LE+1,MN
03800		MP=1
03900		IF(NN(K))MP=-1
04000		NN(K)=IABS(NN(K))
04100	518	NN(K)=MP*(NP*MO+(MOD(NN(K),MO)))
04200		GO TO 503
04300	517	DO 388 K=1,MN
04400		NP=MOD(IMP(K),10)
04500		CALL SETPOG(NP)
04600		CALL INXY(NX,NY,K)
04700		MP=1
04800		IF(NN(K))MP=-1
04900	388	CALL IPEN(NX,NY,MP,NZ)
05000	   	DO 193 I=1,4
05100		KP(I)='VIS  '
05200	193	CALL DPYOUT(I)
05300		CALL SETPOG(1)
05400	140	NP=1
05500		CALL IPOG(NZ)
05600	
05700	211	NS=0
05800	120	LV=0
05900	144	CALL SETCUR(NX,NY,LV)
06000		IF(NS)TYPE 6
06100	6	FORMAT(' :'$)
06200		IF(JF.GT.0)TYPE 634
06300	634	FORMAT(' O'$)
06400		ACCEPT 103,M,N
06500	103	FORMAT(2A1)
06600		LX=NX
06700		LY=NY
06800		CALL RDCUR(NX,NY)
06900		IF(NC)GO TO 191
07000		IF(M.NE.' ')GO TO 11
07100	308	IF(LV.NE.0)GO TO 192
07200	301	CALL IPAK(NX,NY,MN,1,NZ)
07300		LV=1
07400		GO TO 144
07500	192 	CALL IPAK(NX,NY,MN,-1,NZ)
07600	341	N=NP
07700	278	CALL DPYOUT(N)
07800		KP(N)='VIS  '
07900	360	IF(IP)CALL IPOG(NZ)
08000	260	IF(NS)GO TO 144
08100		GO TO 120
08200	
08300	11	IF(M.EQ.':')GO TO 261
08400		IF(M.EQ.'.')GO TO 303
08500		IF(M.EQ.'W')GO TO 380
08600	  	IF(M.EQ.'H')GO TO 306
08700		IF(M.EQ.'V')GO TO 307
08800		IF(M.EQ.'B')GO TO 105
08900	  	IF(M.EQ.'C')GO TO 150
09000		IF(M.EQ.'+')GO TO 500
09100		IF(M.EQ.'-')GO TO 501
09200		IF(M.EQ.'*')GO TO 502
09300		IF(M.EQ.'J')GO TO 608
09400		IF(M.EQ.'O')GO TO 630
09500		IF(M.EQ.'A')GO TO 510
09600		IF(M.EQ.'E')GO TO 425
09700		IF(M.EQ.'G')GO TO 799
09800		IF(M.EQ.'(')GO TO 431
09900		IF(M.EQ.')')GO TO 432
10000	  	IF(M.EQ.'I'.OR.M.EQ.'S')GO TO 230
10100		IF(M.EQ.'X')GO TO 104
10200		IF(M.EQ.'Z')GO TO 580
10300		IF(M.EQ.'F')GO TO 601
10400		IF(M.NE.'P')GO TO 260
10500		IP=-1
10600		IF(N.EQ.'I')GO TO 258
10700		IF(N.EQ.'D')GO TO 340
10800		IF(N.NE.' ')GO TO 231
10900	259	NP=NP+1
11000		IF(NP.GT.4)NP=1
11100	251	CALL SETPOG(NP)
11200		GO TO 503
11300	630	IF(JF.GT.0)GO TO 701
11400		REREAD 710,M,JF
11500	710	FORMAT(A1,I2)
11600		IF(JF.LT.1.OR.JF.GT.19.OR.JF.EQ.10)JF=1
11700		GO TO 261
11800	701	JF=0
11900		GO TO 211
12000	303	IF(LV.EQ.0)GO TO 301
12100		CALL IPAK(NX,NY,MN,-1,NZ)
12200	333	KP(NP)='VIS  '
12300		IF(IP)CALL IPOG(NZ)
12400		CALL DPYOUT(NP)
12500		NX=LX
12600		NY=LY
12700		IF(.NOT.NC)GO TO 301
12800		NC=0
12900		GO TO 211
13000	601	IT=0
13100	702	IT=IT+1
13200		IF(IT.GT.19)GO TO 708
13300		IF(IT.EQ.10)IT=11
13400		I=0
13500		K=0
13600	602	I=I+1
13700		IF(I.GT.MN)GO TO 660
13800	606	IF(MOD(IMP(I),10).NE.NP)GO TO 602
13900		IF(IMP(I)/10.NE.IT)GO TO 602
14000		K=K+1
14100		CALL INXY(N,M,I)
14200		IF(IT.GT.10)CALL INXY(M,N,I)
14300		A(K)=N*NZ/10
14400		B(K)=M*NZ/10
14500		IB(K)=3
14600		IF(NN(I))IB(K)=2
14700		I=I+1
14800		IF(I.LE.MN)GO TO 606
14900	660	IF(K.LT.3)GO TO 702
15000		IB(1)=K
15100		JI=IT
15200		IF(IT.GT.10)JI=IT-10
15300		IF(IS)JI=JI+5
15400		CALL FILLER(A,B,IB,JI,IS,IT,LD,LS)
15500		GO TO 702
15600	708	IF(IS)GO TO 341
15700		GO TO 689
15800	608	NV=-1
15900		IF(LV.EQ.0)NV=1
16000		CALL IPAK(JX,JY,MN,NV,NZ)
16100		NX=JX
16200		NY=JY
16300		GO TO 341
16400	306	NY=LY
16500		GO TO 308
16600	307	NX=LX
16700		GO TO 308
16800	230	IF(N.EQ.' ')GO TO 258
16900	231	IF(N.LT.'1'.OR.N.GT.'4')GO TO 255
17000		REREAD 408,M,N
17100	408	FORMAT(A1,I1)
17200		IF(M.EQ.'S')GO TO 278
17300	   	IF(M.NE.'I')GO TO 256
17400	257	KP(N)='     '
17500		CALL HYDPOG(N)
17600		IF(M.EQ.'P')GO TO 259
17700		GO TO 360
17800	255	IF(M.EQ.'P')GO TO 259
17900	258	IF(M.EQ.'S')GO TO 341
18000		N=NP
18100		GO TO 257
18200	256	NP=N
18300		GO TO 251
18400	261	IF(NS)GO TO 211
18500		NS=-1
18600		IF(LV.EQ.1)GO TO 666
18700		JX=NX
18800		JY=NY
18900		GO TO 301
19000	666	JX=LX
19100		JY=LY
19200		GO TO 192
19300	580	IF(IP)GO TO 581
19400		IP=-1
19500		GO TO 360
19600	581	IP=0
19700		N=5
19800		GO TO 257
19900	500	IF(NZ.EQ.20)GO TO 503
20000		NZ=NZ+1
20100		GO TO 503
20200	501	IF(NZ.EQ.5)GO TO 503
20300		NZ=NZ-1
20400		GO TO 503
20500	502	IF(NZ.EQ.10)GO TO 503
20600		NZ=10
20700	503	CALL CLRPOG(NP)
20800		CALL IDRA(MN,NZ)
20900	335	NS=0
21000		GO TO 341
21100	510	REREAD 516,MO,NAM
21200	516	FORMAT(1XA1,A5)
21300		IF(MO.EQ.'G')GO TO 778
21400		IF(.NOT.LOOKD(NAM))GO TO 260
21500		GO TO 515
21600	778	CALL GETFIL(NAM)
21700		CALL FASTIN(IB,2)
21800		MS=IB(2)
21900		CALL GETFIL(NAM)
22000		CALL FASTIN(IB,MS+2)
22100		CALL GETP(IB,NN(MN+1))
22200		DO 777 K=MN+1,MN+MS
22300		I=NP*100000000
22400		IF(NN(K))I=-I	
22500	777	NN(K)=NN(K)+I	
22600		MN=MN+MS
22700		GO TO 503
22800	340	CALL CLRPOG(NP)
22900		J=0
23000	400	J=J+1
23100	507	IF(J.GT.MN)GO TO 466
23200		MP=MOD(IMP(J),10)
23300		IF(MP.NE.NP)GO TO 400
23400		DO 401 I=J,MN-1
23500	401	NN(I)=NN(I+1)
23600		MN=MN-1
23700		GO TO 507
23800	466	IF(JE)GO TO 467
23900		IP=-1
24000		GO TO 431
24100	105	LP=MOD(IMP(MN),10)
24200		IF(MN.LT.1.OR.LP.NE.NP)GO TO 335
24300		IF(NP.EQ.1)II(2)=II(2)-1
24400		IF(NP.EQ.2)JJ(2)=JJ(2)-1
24500		IF(NP.EQ.3)KK(2)=KK(2)-1
24600		IF(NP.EQ.4)LL(2)=LL(2)-1
24700	        CALL ACCPOG(NP)
24800		MN=MN-1
24900		LV=0
25000		IF(NN(MN))LV=1
25100		GO TO 341
25200	150	NC=-1
25300		IF(LV.NE.1)GO TO 301
25400	191	R=0
25500		MN=MN-1
25600		RM=(NX-LX)**2+(NY-LY)**2
25700		RM=SQRT(RM)
25800		KX=LX+RM*SIND(R)
25900		KY=LY+RM*COSD(R)
26000		CALL IPAK(KX,KY,MN,1,NZ)
26100		DO 151 K=6,360,6
26200		R=K
26300		KX=LX+RM*SIND(R)
26400		KY=LY+RM*COSD(R)
26500	151	CALL IPAK(KX,KY,MN,-1,NZ)
26600		GO TO 333
26700	380	IF(LV.NE.1)GO TO 103
26800		REREAD 377,M,N
26900	377	FORMAT(A1,I2)
27000		IF(N.LT.4)N=100
27100		KN=N/10
27200		IF(KN.LT.2)KN=2
27300		DO 381 I=0,N,KN
27400		CALL IPAK(LX-N/2+I,LY-N/2+I,MN,1,NZ)
27500	381	CALL IPAK(NX-N/2+I,NY-N/2+I,MN,-1,NZ)
27600		GO TO 341
27700	799	LX=NX*10/NZ
27800		LY=NY*10/NZ
27900		I=MN
28000		NY=1000
28100		DO 801 K=1,MN
28200		CALL INXY(JX,JY,K)
28300		NX=IABS(JX-LX)+IABS(JY-LY)
28400		IF(NY.LT.NX)GO TO 801
28500		I=K
28600		NY=NX
28700	801	CONTINUE
28800		LF=0
28900		MP=NP
29000		IN=1
29100		GO TO 548
29200	813	IN=-1
29300		I=MN+1
29400		GO TO 426
29500	425	I=0
29600		MP=NP
29700		IF(N.EQ.'E')GO TO 813
29800		IN=1
29900	426	I=I+IN
30000	784	IF(I.GT.MN.OR.I.LT.1)GO TO 804
30100	548	CALL INXY(NX,NY,I)
30200		CALL SETCUR(NX*NZ/10,NY*NZ/10,1)
30300	794	IF(IN)TYPE 815
30400	815	FORMAT(' -'/)
30500		TYPE 469
30600	469	FORMAT(' EDIT?'$)
30700		ACCEPT 103,M,N
30800		IF(M.EQ.' ')GO TO 426
30900		IF(M.EQ.'-')GO TO 810
31000		IF(M.EQ.'+')GO TO 783
31100		IF(M.EQ.'D')GO TO 470
31200		IF(M.EQ.'I')GO TO 547
31300		IF(M.EQ.'O')GO TO 782
31400		IF(M.EQ.'C')GO TO 800
31500		IF(M.EQ.':')GO TO 790
31550		IF(M.EQ.')')GO TO 900
31600		CALL RDCUR(NX,NY)
31700		IF(M.EQ.'M')GO TO 780
31800		IF(M.NE.'B')GO TO 804
31900		I=I-IN
32000		GO TO 548
32100	804	NP=MP
32200		GO TO 211
32300	810	IN=-IN
32400		GO TO 426
32410	900	IF(IN)GO TO 901
32420		IM=I
32430		NF=LF
32440		GO TO 794
32450	901	IM=LF
32460		NF=I
32470		GO TO 794
32500	800	IF(LF.EQ.0.OR.LF.GT.MN)LF=I
32600		NP=MP
32700		DO 806 K=LF,I,IN
32800		CALL INXY(NX,NY,K)
32900		JF=IMP(K)/10
33000		MS=1
33100		IF(NN(K))MS=-1
33200	806	CALL IPAK(NX,NY,MN,MS,10)
33300	814	JF=0
33400		LF=0
33500		GO TO 471
33600	790	LF=I
33700		GO TO 794
33800	780	JF=IMP(I)/10
33900		LF=I
34000		GO TO 786
34100	783	REREAD 377,M,N
34200		I=I+IN*N
34300		GO TO 784
34400	782	REREAD 377,M,JF
34500		IF(JF.OR.JF.EQ.10.OR.JF.GT.19)JF=0
34600		IF(LF.EQ.0.OR.LF.GT.MN)LF=I
34700	796	CALL INXY(NX,NY,LF)
34800	786	MS=1
34900		IF(NN(LF))MS=-1
35000		NP=MOD(IMP(LF),10)
35100		LF=LF-1
35200		CALL IPAK(NX,NY,LF,MS,10)
35300		LF=LF+IN
35400		IF(IN.AND.(LF-I))GO TO 814
35500		IF(.NOT.IN.AND.(I-LF))GO TO 814
35600		GO TO 796
35700	547	NN(I)=-NN(I)
35800		GO TO 471
35900	470	MN=MN-1
36000		DO 428 K=I,MN
36100	428	NN(K)=NN(K+1)
36200	471	CALL CLRPOG(NP)
36300		CALL IDRA(MN,NZ)
36400		CALL DPYOUT(NP)
36500		GO TO 784
36600	431	NX=0
36700		NY=0
36800		NF=MN+1
36900		IM=0
37000		GO TO 211
37100	432	IF(IM.EQ.0)IM=MN
37200		DO 433 I=NF,IM
37300		CALL INXY(IX,IY,I)
37400		IX=NX+IX
37500		IY=NY+IY
37600		MP=1
37700		IF(NN(I))MP=-1
37800	433	CALL IPAK(IX,IY,MN,MP,NZ)
37900		GO TO 341
38000	
38100	104	CALL CLRCUR
38200		CALL IPOG(NZ)
38300		IP=-1
38400	   	TYPE 111
38500	111	FORMAT(' TYPE:<CR>;TO CONTINUE.'/' TYPE:''N''<CR>;TO START OVER.'/
38600		2' TYPE:''X'' TO SAVE VIS POGS IF FINISHED'/
38700		3' OR TYPE:''P'' TO PLOT ALL VIS POGS'/)
38800		ACCEPT 103,M,NV
38900		IF(M.EQ.'N')GO TO 1
39000		IF(M.EQ.'P')GO TO 557
39100		IF(M.NE.'X')GO TO 120
39200	127	TYPE 121
39300	121	FORMAT(' TYPE A FIVE LETTER NAME FOR THIS PICTURE.'/)
39400		ACCEPT 3,NAM
39500		IF(NAM.EQ.'     ')GO TO 127
39600	557	MP=0
39700		DO 405 IK=1,4
39800		IF(KP(IK).NE.'VIS  ')GO TO 405
39900		MP=MP+1
40000	405	CONTINUE
40100		IF(MP.EQ.0)GO TO 104
40200		IF(M.EQ.'P')GO TO 555
40300		NP=0
40400		JE=-1
40500	467	NP=NP+1
40600		IF(NP.GT.4)GO TO 468
40700		IF(KP(NP).NE.'VIS  ')GO TO 340
40800		GO TO 467
40900	468	CALL OFILE(1,NAM)
41000		WRITE(1)MN,(NN(K),K=1,MN)
41100		END FILE 1
41200		GO TO 1
41300	555	TYPE 587
41400	587	FORMAT(/' PLOTING CURRENT POG'/)
41500		CALL PLOTS(I)
41600		IF(NV.EQ.'L')GO TO 797
41700		IF(NV.EQ.'S')GO TO 850
41800		IF(NV.NE.'D'.AND.NV.NE.'B')GO TO 851
41900		LD=-1
42000	850	LS=-1
42100	851	IS=0
42200		GO TO 601
42300	689	IF(NV.EQ.'S'.OR.NV.EQ.'D'.OR.NV.EQ.'Z')GO TO 711
42400	797	DO 556 I=1,MN
42500		IF(MOD(IMP(I),10).NE.NP)GO TO 556
42600		CALL INXY(NX,NY,I)
42700		MO=3
42800		IF(NN(I))MO=2
42900		CALL PLOT(NX*NZ/10,NY*NZ/10,MO)
43000	556	CONTINUE
43100	711	CALL PLOT(0,0,3)
43200		TYPE 691
43300	691	FORMAT(' FINISHED PLOTING!'/)
43400		IS=-1
43500		LS=0
43600		LD=0
43700		GO TO 211
43800		END
43900	
44000		SUBROUTINE IPOG(NZ)
44100		COMMON KP(5),NP,NN(4096),JF
44200		DIMENSION MM(24),JP(4)
44300		CALL DPYSET(5,MM,24)
44400		CALL DPYTXT(100,-430,'POG1 POG2 POG3 POG4 ZOOM ',5)
44500		KP(5)=' REG '
44600		IF(NZ.LT.10)KP(5)=' --- '
44700		IF(NZ.GT.10)KP(5)=' +++ '
44800		CALL DPYTXT(100,-450,KP,5)
44900		DO 4 J=1,4
45000		JP(J)='     '
45100	4	IF(J.EQ.NP)JP(J)=' ↑↑  '
45200		CALL DPYTXT(100,-470,JP,4)
45300		CALL DPYOUT(5)
45400		CALL SETPOG(NP)
45500		RETURN
45600		END
45700		SUBROUTINE IPAK(NX,NY,MN,MP,NZ)
45800		COMMON KP(5),NP,NN(4096),JF
45900		MN=MN+1
46000		IX=(NX*10/NZ)+1024
46100		IY=(NY*10/NZ)+1024
46200		NN(MN)=MP*((JF*10+NP)*100000000+IX*10000+IY)
46300		CALL IPEN(NX,NY,MP,10)
46400		RETURN
46500		END
46600		SUBROUTINE IPEN(NX,NY,MP,NZ)
46700		IX=NX*NZ/10
46800		IF(IX.GT.950)IX=950
46900		IF(IX.LT.-950)IX=-950
47000		IY=NY*NZ/10
47100		IF(IY.GT.950)IY=950
47200		IF(IY.LT.-950)IY=-950
47300		IF(MP)GO TO 1
47400		CALL AIVECT(IX,IY)
47500		RETURN
47600	1	CALL AVECT(IX,IY)
47700		RETURN
47800		END
47900		SUBROUTINE INXY(NX,NY,MN)
48000		COMMON KP(5),NP,NN(4096),JF
48100		J=IABS(NN(MN))
48200		NY=MOD(J,10000)-1024
48300		NX=(MOD(J,100000000)/10000)-1024
48400		RETURN
48500		END
48600		SUBROUTINE IDRA(MN,NZ)
48700		COMMON KP(5),NP,NN(4096),JF
48800		DO 1 I=1,MN
48900		KF=MOD(IABS(NN(I)/100000000),10)
49000		IF(KF.NE.NP)GO TO 1
49100		CALL INXY(IX,IY,I)
49200		CALL IPEN(IX,IY,NN(I),NZ)
49300	1	CONTINUE
49400		RETURN
49500		END